home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / pbc22b.zip / PBC$BAS.ZIP / CALCDATE.BAS < prev    next >
BASIC Source File  |  1993-01-01  |  1KB  |  39 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB CheckDate (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, ErrCode%)
  8.    DECLARE SUB DateA2R (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, RelDate&)
  9.    DECLARE SUB DateN2S (MonthNr%, DayNr%, YearNr%, DateSt$)
  10.    DECLARE SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
  11.  
  12. SUB CalcDate (StartDate$, Days&, Direction%, NewDate$, ErrCode%)
  13.    M% = VAL(StartDate$)
  14.    D% = VAL(MID$(StartDate$, 4))
  15.    Y% = VAL(MID$(StartDate$, 7))
  16.    IF Y% < 100 THEN Y% = Y% + 1900
  17.    CheckDate M%, D%, Y%, ErrCode%
  18.    IF ErrCode% THEN
  19.       ErrCode% = 2
  20.       EXIT SUB
  21.    END IF
  22.  
  23.    DateA2R M%, D%, Y%, SDate&
  24.    IF Direction% THEN
  25.       SDate& = SDate& - Days&
  26.    ELSE
  27.       SDate& = SDate& + Days&
  28.    END IF
  29.    IF SDate& < 0& THEN
  30.       ErrCode% = 3
  31.       EXIT SUB
  32.    END IF
  33.  
  34.    ErrCode% = 0
  35.    DateR2A M%, D%, Y%, SDate&
  36.    NewDate$ = StartDate$
  37.    DateN2S M%, D%, Y%, NewDate$
  38. END SUB
  39.